﻿Imports ADODB
Public NotInheritable Class DBFunctions
  Implements IDisposable
  Public Class DBFunctionException
    Inherits Exception
    Private sqlcommandtextField As String
    Public ReadOnly Property sqlCommandText() As String
      Get
        Return sqlcommandtextField
      End Get
    End Property
    Private ParametersField As Object
    Public ReadOnly Property Parameters() As ADODB.Parameters
      Get
        Return Me.ParametersField
      End Get
    End Property
    Sub New(ByVal base As Exception, ByVal sql As String)
      MyBase.New(base.Message, base)
      sqlcommandtextField = sql
    End Sub
    Sub New(ByVal base As Exception, ByVal sql As String, ByVal sqlParameters As Object)
      MyBase.New(base.Message, base)
      ParametersField = sqlParameters
    End Sub
  End Class

  Public Shared Event ExceptionOccurred As UnhandledExceptionEventHandler
  Private Shared isConnectionStringSetValue As Boolean = False
  Private Shared connectionString As String

  Public Shared ReadOnly Property IsConnectionStringSet() As Boolean
    Get
      Return isConnectionStringSetValue
    End Get
  End Property
  Public Shared Sub SetConnectionString(ByVal newConnectionString As String)
    Try
      Dim tmp As New ADODB.Connection
      tmp.ConnectionString = newConnectionString
      tmp.Open()
      connectionString = newConnectionString
      tmp.Close()
      isConnectionStringSetValue = True
    Catch ex As Exception
      RaiseEvent ExceptionOccurred(GetType(DBFunctions), New UnhandledExceptionEventArgs(ex, False))
    End Try
  End Sub
  Private Shared Function GetNewConnection() As Connection
    Try
      If Not IsConnectionStringSet Then Throw New InvalidExpressionException("Connection string is not set.")
      Dim tmp As New ADODB.Connection
      tmp.Open(connectionString)
      Return tmp
    Catch ex As Exception
      RaiseEvent ExceptionOccurred(GetType(DBFunctions), New UnhandledExceptionEventArgs(ex, False))
    End Try
    Return Nothing
  End Function
  Private cn As ADODB.Connection
  Private cmd As ADODB.Command
  Private rs As ADODB.Recordset
  Public ReadOnly Property LastRecordSet() As ADODB.Recordset
    Get
      Return rs
    End Get
  End Property
  Sub New()
    cn = GetNewConnection()
    If cn Is Nothing Then Exit Sub
    cmd = New ADODB.Command
    cmd.ActiveConnection = cn

  End Sub
  Private Function ExecSQLCommand(ByVal sql As String, ByVal ParamArray Parameters() As ADODB.Parameter) As ADODB.Recordset
    Try
      Dim cmd_ As New ADODB.Command
      cmd_.ActiveConnection = cn
      If Parameters IsNot Nothing Then
        For Each p As ADODB.Parameter In Parameters
          cmd_.Parameters.Append(p)
        Next
      End If
      'cmd_.
      cmd_.CommandText = sql
      rs = cmd_.Execute
      Return rs
    Catch ex As Exception
      RaiseEvent ExceptionOccurred(Me, New UnhandledExceptionEventArgs(New DBFunctionException(ex, sql, Parameters), False))
    End Try
    Return Nothing
  End Function
  Public Function ExecSQLCommand(ByVal sql As String) As ADODB.Recordset
    Try
      cmd.CommandText = sql
      rs = cmd.Execute
      Return rs
    Catch ex As Exception
      RaiseEvent ExceptionOccurred(Me, New UnhandledExceptionEventArgs(New DBFunctionException(ex, sql), False))
    End Try
    Return Nothing
  End Function
  Public Function InsertBLOBOn(ByVal TableName As String, ByVal FieldName As String, ByVal BlobValue() As Byte)
    Dim sql As String _
    = String.Format("INSERT INTO {0} ({1}) VALUES (?);", TableName, FieldName)
    Return ExecSQLCommand(Sql, CreateBlobInputParameter(BlobValue))
  End Function
  Public Function UpdateBLOBOn(ByVal TableName As String, ByVal FieldName As String, ByVal BlobValue() As Byte, ByVal Where As String)
    If Where.Trim.StartsWith("WHERE", True, System.Threading.Thread.CurrentThread.CurrentCulture) Then _
      Where = Where.Trim.Remove(0, 5)
    Dim sql As String _
        = String.Format("UPDATE {0} SET {1} = ? WHERE 1 AND {2};", TableName, FieldName, Where)
    Return ExecSQLCommand(sql, CreateBlobInputParameter(BlobValue))
  End Function
  Private Function CreateBlobInputParameter(ByVal BlobValue() As Byte) As ADODB.Parameter
    Return cmd.CreateParameter(, DataTypeEnum.adBinary, ParameterDirectionEnum.adParamInput, BlobValue.Length, BlobValue)
  End Function
  Public Function GetValueOf(ByVal OneField As String) As String
    'If WhereClause.Trim.ToLower.StartsWith("where") Then WhereClause = WhereClause.Trim.Substring(5).Trim
    Dim sql As String = "SELECT " & OneField & ";" ' & " FROM " & TableName & " WHERE " & WhereClause
    rs = ExecSQLCommand(sql)
    If Not (rs.BOF And rs.EOF) Then
      Dim ret As String = rs.GetString(StringFormatEnum.adClipString, , "", "", "")
      Return ret.Replace(Chr(13), "")
    End If
    'If Not String.IsNullOrEmpty(NotFoundString) Then Return NotFoundString
    Return String.Empty
  End Function
  Public Function GetValueOf(ByVal TableName As String, ByVal FieldName As String, ByVal WhereClause As String, Optional ByVal NotFoundString As String = Nothing) As String
    If WhereClause.Trim.ToLower.StartsWith("where") Then WhereClause = WhereClause.Trim.Substring(5).Trim
    Dim sql As String = "SELECT " & FieldName & " FROM " & TableName & " WHERE " & WhereClause
    rs = ExecSQLCommand(sql)
    If Not (rs.BOF And rs.EOF) Then
      Dim ret As String = rs.GetString(StringFormatEnum.adClipString, , "", "", "")
      Return ret.Replace(Chr(13), "")
    End If
    If Not String.IsNullOrEmpty(NotFoundString) Then Return NotFoundString
    Return String.Empty
  End Function
  Public Function InsertInto(ByVal TableName As String, ByVal Fields As String, ByVal Values As String) As Boolean
    Dim sql As New System.Text.StringBuilder
    sql.AppendFormat("INSERT INTO {0} ({1}) VALUES ({2});", TableName, Fields, Values)
    Dim o As Object = ExecSQLCommand(sql.ToString)
    Return (o IsNot Nothing)
  End Function
  Public Function UpdateTable(ByVal TableName As String, ByVal WhereClause As String, ByVal ParamArray SetValues() As String) As Boolean
    Dim sql As New System.Text.StringBuilder
    If ValueOfExists(TableName, WhereClause) Then
      ValidateWhereClause(WhereClause) 'If WhereClause.ToLower.Trim.StartsWith("where") Then WhereClause = WhereClause.Substring(5).Trim
      sql.AppendFormat("UPDATE {0} SET {2} WHERE {1}", TableName, WhereClause, String.Join(", ", SetValues))
      Dim o As Object = ExecSQLCommand(sql.ToString)
      If o IsNot Nothing Then
        'cn.t
        'cn.CommitTrans()
        Return True
      End If
    End If
    Return False
  End Function
  Public Function DeleteFrom(ByVal TableName As String, ByVal WhereClause As String) As Boolean
    Dim sql As New System.Text.StringBuilder
    ValidateWhereClause(WhereClause)
    sql.AppendFormat("DELETE FROM {0} WHERE {1}", TableName, WhereClause)
    rs = ExecSQLCommand(sql.ToString)
    If rs IsNot Nothing Then _
      Return True
    Return False
  End Function
  <DebuggerStepThrough()> _
  Private Shared Function ValidateWhereClause(ByRef whereClause As String) As String
    'If whereClause Is Nothing Then Return ""
    If String.IsNullOrEmpty(whereClause) Then whereClause = 1
    If whereClause.ToLower.Trim.StartsWith("where") Then whereClause = whereClause.Substring(5).Trim
    Return whereClause
  End Function
  Public Function ValueOfExists(ByVal TableName As String, ByVal WhereClause As String) As Boolean
    'If WhereClause.ToLower.Trim.StartsWith("where") Then WhereClause = WhereClause.Substring(5).Trim
    ValidateWhereClause(WhereClause)
    If String.IsNullOrEmpty(WhereClause) Then WhereClause = 1
    Dim sql As String = "SELECT * FROM " & TableName & " WHERE " & WhereClause & ";"
    Dim o As Object = ExecSQLCommand(sql)
    If o IsNot Nothing Then
      With CType(o, Recordset)
        If Not (.EOF And .BOF) Then Return True
      End With
    End If
    Return False
  End Function
  Public Function GetTables() As String()
    rs = ExecSQLCommand("SHOW TABLES;")
    If rs Is Nothing Then Return Nothing
    If (rs.BOF And rs.EOF) Then Return Nothing
    Dim t() As String = CStr(rs.GetString(StringFormatEnum.adClipString, RowDelimeter:="|", NullExpr:="")).Split("|")
    Do Until Not String.IsNullOrEmpty(t(t.Length - 1))
      ReDim Preserve t(t.Length - 2)
    Loop
    Return t
  End Function
  Public Function DescribeTable(ByVal TableName As String) As String
    Dim sql As New System.Text.StringBuilder
    sql.AppendFormat("DESCRIBE {0}", TableName)
    rs = ExecSQLCommand(sql.ToString)
    If rs IsNot Nothing Then
      If Not (rs.BOF And rs.EOF) Then
        Dim s As String = rs.GetString(StringFormatEnum.adClipString, , vbTab, vbCrLf, "")
        Return s
      End If
    End If
    Return Nothing
  End Function
  Public Function DropTable(ByVal TableName As String) As Boolean
    Dim sql As String = "DROP TABLE " & TableName & ";"
    Dim o As ADODB.Recordset = ExecSQLCommand(sql)
    If o IsNot Nothing Then Return True
    Return False
  End Function
  Public Function TableExists(ByVal TableName As String) As Boolean
    'Dim s As String = ""
    Try
      Dim rs As ADODB.Recordset = Nothing
      'tmpcn.Execute("SELECT * FROM " & NomeTabela & " WHERE 1=0")
      rs = cn.Execute("SHOW TABLES like '" & TableName & "';")
      If rs.EOF And rs.BOF Then Return False
      Return True
    Catch ex As Exception
      RaiseEvent ExceptionOccurred(Me, New UnhandledExceptionEventArgs(ex, False))
      Return False
    End Try
  End Function
  Public Class DatabaseBackup
    Private databaseNameField As String
    Private tablesField As New ObjectModel.Collection(Of DatabaseTable)
    Sub New(ByVal dbName As String, ByVal ParamArray ignoredTables() As String)
      databaseNameField = dbName
      Dim db As New DBEnvironment.DBFunctions
      Dim t() As String = db.GetTables()
      db.Dispose()
      Dim ignore As Boolean
      For Each table As String In t
        ignore = False
        For Each ignoredTable As String In ignoredTables
          If ignoredTable = table Then
            ignore = True
            Exit For
          End If
        Next
        If Not ignore Then _
        tablesField.Add(table)
      Next table
    End Sub
    Public ReadOnly Property DatabaseName() As String
      Get
        Return databaseNameField
      End Get
    End Property
    Public ReadOnly Property Tables() As ObjectModel.Collection(Of DatabaseTable)
      Get
        Return tablesField
      End Get
    End Property
    Public Class DatabaseTable
      Private tableNameField As String
      Private fieldsField As New ObjectModel.Collection(Of DatabaseTableField)
      Private rowsField As New ObjectModel.Collection(Of DatabaseTableRow)
      Public ReadOnly Property Name() As String
        Get
          Return tableNameField
        End Get
      End Property
      Public ReadOnly Property Fields() As ObjectModel.Collection(Of DatabaseTableField)
        Get
          Return fieldsField
        End Get
      End Property
      Public Shared Narrowing Operator CType(ByVal tableName As String) As DatabaseTable
        Dim dbt As New DatabaseTable
        Dim db As New DBFunctions
        Dim rs As Object = db.DescribeTable(tableName)
        With dbt
          .tableNameField = tableName
          Dim f() As String = rs.Split(vbCrLf)
          For i As Integer = 0 To f.Length - 1
            Dim v() As String = f(i).Split(vbTab)
            .fieldsField.Add(DatabaseTableField.Create(v(0), v(1), v(2), v(3), v(4), v(5)))
          Next
          rs = db.ExecSQLCommand("SELECT * FROM " & tableName)
          If Not (rs.BOF And rs.EOF) Then
            Dim r() As String = rs.GetString(StringFormatEnum.adClipString, , Chr(255), Chr(254), "").Split(Chr(254))
            For i As Integer = 0 To r.Length - 1
              .rowsField.Add(r(i))
            Next
          End If
        End With
        Return dbt
      End Operator
      Public Class DatabaseTableField
        Private nameField As String
        Private typeField As String
        Private isNullField As String
        Private keyField As String
        Private defaultValueField As String
        Private extraField As String
        Public ReadOnly Property Name() As String
          Get
            Return nameField
          End Get
        End Property
        Public ReadOnly Property [Type]() As String
          Get
            Return typeField
          End Get
        End Property
        Public ReadOnly Property IsNull() As String
          Get
            Return isNullField
          End Get
        End Property
        Public ReadOnly Property Key() As String
          Get
            Return keyField
          End Get
        End Property
        Public ReadOnly Property DefaultValue() As String
          Get
            Return defaultValueField
          End Get
        End Property
        Public ReadOnly Property Extra() As String
          Get
            Return extraField
          End Get
        End Property
        Public Shared Function Create(ByVal newName As String, _
        ByVal newType As String, ByVal newIsNull As String, ByVal newKey As String, _
        ByVal newDefaultValue As String, ByVal newExtra As String) As DatabaseTableField
          Dim dtf As New DatabaseTableField
          With dtf
            .nameField = newName
            .typeField = newType
            .isNullField = newIsNull
            .keyField = newKey
            .defaultValueField = newDefaultValue
            .extraField = newExtra
          End With
          Return dtf
        End Function

        Public Shared Widening Operator CType(ByVal initialData As DatabaseTableField) As String
          Dim sql As New System.Text.StringBuilder
          With initialData
            sql.AppendFormat("{0} {1} {2} DEFAULT {3}", _
            .Name, _
            .Type, _
            IIf(.IsNull = "YES", "NULL", "NOT NULL"), _
            IIf(IsNumeric(.DefaultValue), .DefaultValue, IIf(Not String.IsNullOrEmpty(.DefaultValue) And Not .DefaultValue.ToUpper = "NULL", "'" & .DefaultValue & "'", "NULL")), _
            .Extra)
          End With
          Return sql.ToString
        End Operator

      End Class
      Public Class DatabaseTableRow
        Private valuesField() As Object
        Private valuesTypeField() As Type
        Public ReadOnly Property Values() As Object()
          Get
            Return valuesField
          End Get
        End Property
        Public Shared Narrowing Operator CType(ByVal initialData As String) As DatabaseTableRow
          Dim dtr As New DatabaseTableRow
          With dtr
            Dim v() As Object = initialData.Split(Chr(255))
            ReDim .valuesField(v.Length - 1)
            ReDim .valuesTypeField(v.Length - 1)
            For i As Integer = 0 To v.Length - 1
              .valuesField(i) = v(i)
              If IsDate(.valuesField(i)) Then
                .valuesTypeField(i) = GetType(Date)
              ElseIf IsNumeric(.valuesField(i)) Then
                .valuesTypeField(i) = Val(.valuesTypeField(i)).GetType
              Else
                .valuesTypeField(i) = GetType(String)
              End If
            Next
          End With
          Return dtr
        End Operator
        Public Shared Widening Operator CType(ByVal initialData As DatabaseTableRow) As String
          Dim out As New System.Text.StringBuilder
          Dim format As String = ""
          Dim nds As String, ngs As String

          With initialData
            For i As Integer = 0 To .valuesTypeField.Length - 1
              Select Case .valuesTypeField(i).Name.ToUpper
                Case "DATE"
                  format = "'{0}'"
                Case "INTEGER"
                  format = "{0}"
                Case "DOUBLE"
                  format = "{0}"
                  With My.Application.Culture.NumberFormat
                    nds = .NumberDecimalSeparator
                    ngs = .NumberGroupSeparator
                    .NumberDecimalSeparator = "."
                    .NumberGroupSeparator = ","
                    initialData.valuesField(i) = CDbl(initialData.valuesField(i)).ToString
                    .NumberDecimalSeparator = nds
                    .NumberGroupSeparator = ngs
                  End With
                Case "STRING"
                  format = "'{0}'"
                Case Else
                  MsgBox(.valuesTypeField(i).Name.ToUpper)
              End Select
              out.AppendFormat(format, .valuesField(i))
            Next
          End With
          Return out.ToString
        End Operator
      End Class


      Public Shared Widening Operator CType(ByVal initialData As DatabaseTable) As String
        Dim sql As New System.Text.StringBuilder
        sql.AppendFormat("CREATE TABLE IF NOT EXISTS {0} (", initialData.Name)
        Dim fieldCollection As New ObjectModel.Collection(Of String)
        Dim primaryKeyFields As New ObjectModel.Collection(Of String)
        For Each dtf As DatabaseTableField In initialData.Fields
          If dtf.Key = "PRI" Then primaryKeyFields.Add(dtf.Name)
          fieldCollection.Add(dtf)
        Next
        Dim fields(fieldCollection.Count - 1) As String
        fieldCollection.CopyTo(fields, 0)
        sql.Append(String.Join(", ", fields))
        If primaryKeyFields.Count > 0 Then
          Dim pkeys(primaryKeyFields.Count - 1) As String
          primaryKeyFields.CopyTo(pkeys, 0)
          sql.AppendFormat(", PRIMARY KEY({0})", String.Join(", ", pkeys))
        End If
        sql.Append(");")
        Return sql.ToString
      End Operator

    End Class
  End Class
  Public Function GetCurrentDatabaseName() As String
    Dim tmp As ADODB.Recordset = cn.Execute("SELECT DATABASE();")
    If tmp IsNot Nothing Then
      If Not (tmp.EOF And tmp.BOF) Then
        Dim s As String = tmp.Fields(0).Value
        Return s
      End If
    End If
    Return Nothing
  End Function

  Private disposedValue As Boolean = False    ' To detect redundant calls

  ' IDisposable
  Protected Sub Dispose(ByVal disposing As Boolean)
    If Not Me.disposedValue Then
      If disposing Then
        ' TODO: free unmanaged resources when explicitly called
        cmd.Cancel()
        cn.Close()
        rs.Cancel()

      End If

      ' TODO: free shared unmanaged resources
    End If
    Me.disposedValue = True
  End Sub
  Public Function GetMD5Hash(ByVal Text As String) As String
    Dim hash As String = Me.GetValueOf("md5('" & Text & "');")
    Return hash
  End Function
#Region " IDisposable Support "
  ' This code added by Visual Basic to correctly implement the disposable pattern.
  Public Sub Dispose() Implements IDisposable.Dispose
    ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
    Dispose(True)
    GC.SuppressFinalize(Me)
  End Sub
#End Region

End Class
